home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 19
/
Aminet 19 (1997)(GTI - Schatztruhe)[!][Jun 1997].iso
/
Aminet
/
comm
/
cnet
/
cnet_toolkit.lha
/
CNet_ToolKit.REXX!
< prev
next >
Wrap
Text File
|
1997-04-05
|
78KB
|
1,779 lines
****************************************************************************
CNet ARexx Tool Kit, v3.00 by DOTORAN - For CNet v4.26b & v3.05c!
A Collection of Useful ARexx SubRoutines & Procedures!
Please use ANY of these in your OWN ARexx Creations!
$VER: CNet ARexx Tool Kit, v3.00 (5-Apr-97) Compiled by Dotoran!
****************************************************************************
CONTENTS:
[01] : From "Expanded" date to "Sorted" or "Internal" date format.
[02] : From x5xxxxx GU Value to "Sorted" or "Internal" date format.
[03] : From "Sorted" or "Internal" date to "Expanded" date format.
[04] : Numeric Range Parser: [ -2 19- 4 7-9 11.13.15,17 ]
[05] : CNet-like input routine, using MCI.
[06] : Find and return BBSTEXT/BBSMENU line entry.
* [07] : Check the CNet Amiga Version file is being run under.
U [08] : Check if a user is Suboperator in current subboard.
U [09] : Checks if MCI is enabled in current subboard.
F [10] : Convert from 12/24 hour time format to 12/24/min format.
[11] : External Library Loader
U [12] : View, Enable, Disable or Toggle "Priviledge" Flags.
[13] : Get "Arguments" from last command.
[14] : Read "Cursor Key" / "Return/Enter" Keyboard Input.
[15] : Convert "UPPERCASE" to "lowercase" text.
[16] : Pauses output for "x" number of seconds the RIGHT way!
[17] : Checks for "Loss of Carrier" in your Pfiles!
[18] : An informative "Error Checking" routine.
[19] : Positions cursor for printing anywhere on the screen.
[20] : Horizontal Text Scroller Number 1.
[21] : Horizontal Text Scroller Number 2.
[22] : Read the joystick(s) and firebutton(s).
[23] : First attempt at MOUSE capability. (95% Complete!)
[24] : Disable or Enable the MORE? prompt, regardless of setting!
[25] : Muffle ALL ports, regardless of setting!
[26] : Extended SelectFile Routine.
[27] : Add line of text to specified LOG file.
U [28] : Check Port Menu(s) Checkmark Status.
U [29] : Send Text File as CNet MAIL to specified User.
* [30] : Send a CNet/4 "File Attach" EMail Message to specified User.
U [31] : Send a System OLM (OnLine Message) to the current user.
[32] : Add keystrokes to other ports from present port.
[33] : A QUICK "Who" for SysOps, listing Access Group Number.
[34] : View "port" log of specified port. (Pre "calls" log).
[35] : Send Line Noise to a port (Ability to kick them off too!)
[36] : UnLock User Accounts (That May NOT Have Been Previously!)
[37] : Replace <input> with <output> within string of <text>.
E [38] : Find and Return or Verify BBSMENU section line(s).
E [39] : Clears a specific port, by dumping the user.
[40] : EnCode & DeCode text strings, using a Numeric Key.
* [41] : Guideline Entry-text for Mail (and File) Subboards.
* [42] : NewDoor starter framework for New ARexx Doors/Pfiles.
* = New routines to this version of the CNet Amiga ToolKit, v3.00.
F = Fixed routine since the last time.
U = Updated routine since the last time.
E = Expanded Ability & Updated since last time.
****************************************************************************
/**[01]*********************************************************************
*
* Description: From "Expanded" date to "Sorted" or "Internal" date format.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Expanded: Sun 25-Dec-1993 11:53a
* Sorted: 19970330 (In YYYYMMDD Format)
* Internal: 7028 (# of Days since 1/1/78)
*
* Usage: <var>=SDATE(<date>,[mode])
*
* Where: <date> holds an "Expanded" Date.
* [mode] as "i" returns Internal Days Format.
* (Number of days since January 1, 1978)
*
* Returns: <var> holds the sorted (or internal) date format.
*
* Note 1: Because of the way the internal ARexx DATE() command works,
* you should NOT use dates PREVIOUS to January 1, 1978 when
* using the "i" (internal) setting. This routine will, however
* return the SORTED date for ANY DATE given.
*
* Note 2: We decided to keep the "i" parameter, because it's a FAST
* way to perform MATH functions on dates(13 days ago, etc).
*/
getuser 1500000 ; d1=result ; d2=SDATE(d1) ; d3=SDATE(d1,"i")
transmit "Expanded Date: "d1
transmit " Sorted Date: "d2
transmit "Internal Days: "d3
exit
SDATE: procedure;arg da,mo
da=substr(da,12,4)right(index("ANEBARPRAYUNULUGEPCTOVEC",substr(da,9,2))%2+1,2,"0")right(strip(substr(da,5,2)),2,"0")
if mo="I" then return date("i",da,"s")
return da
/**[02]*********************************************************************
*
* Description: From x5xxxxx GU Value to "Sorted" or "Internal" date format.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* x5xxxxx: 1500000, 1500410, 2500990, etc.
*
* Sorted: 19970330 (In YYYYMMDD Format)
*
* Internal: 7028 (# of Days since 1/1/78)
*
* Usage: <var>=GDATE(<value>,[mode])
*
* Where: <value> holds the 7-Digit x5xxxxx GetUser Value.
* [mode] as "i" returns Internal Days Format.
* (Number of days since January 1, 1978)
*
* Returns: <var> holds the sorted (or internal) date format.
*
* Note 1: Because of the way the internal ARexx DATE() command works,
* you should NOT use dates PREVIOUS to January 1, 1978 when
* using the "i" (internal) setting. This routine will, however
* return the SORTED date for ANY DATE given.
*
* Note 2: We decided to keep the "i" parameter, because it's a FAST
* way to perform MATH functions on dates(13 days ago, etc).
*
* Fixed: The usage template above stated SDATE, instead of GDATE.
* The GDATE routine used an UPPERCASE month template, which
* returned incorrect month numerations, because LOWERCASE
* characters are returned when reading DATE GetUsers.
*/
getuser 1500416;a=result;transmit "Expanded 1st Call Date: "a
d1=GDATE(1500416);transmit " Sorted 1st Call Date: "d1
d2=GDATE(1500416,"i");transmit "Internal 1st Call Date: "d2
exit
GDATE: procedure;arg da,mo;getuser da;da=result
da=substr(da,12,4)right(index("anebarprayunulugepctovec",substr(da,9,2))%2+1,2,"0")right(strip(substr(da,5,2)),2,"0")
if mo="I" then return date("i",da,"s")
return da
/**[03]*********************************************************************
*
* Description: From "Sorted" or "Internal" date to "Expanded" date format.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Sorted: 19970330 (In YYYYMMDD Format)
* Internal: 7028 (# of Days since 1/1/78)
* Expanded: Sun 30-Mar-1997 (No time format!)
*
* Usage: <var>=EDATE(<date>,[mode])
*
* Where: <date> holds a "Sorted" or "Internal" Date.
* [mode] Specified as 'i' if <date> supplied is in
* Internal Days Format.
* (Number of days since January 1, 1978)
*
* Returns: <var> holds the expanded date format.
*
* Note 1: Because of the way the internal ARexx DATE() command works,
* you should NOT use dates PREVIOUS to January 1, 1978 when
* using the "i" (internal) setting. This routine will, however
* return the SORTED date for ANY DATE given.
*
* Note 2: We decided to keep the "i" parameter, because it's a FAST
* way to perform MATH functions on dates(13 days ago, etc).
*/
d1="19970330" ; d2=EDATE(d1) ; d3="7028" ; d4=EDATE(d3,"i")
transmit " Sorted Date: "d1" = Expanded Date: "d2
transmit "Internal Days: "d3" = Expanded Date: "d4
exit
EDATE: procedure;arg da,mo;if mo="I" then da=date("s",da,"i")
return left(date("w",da,"s"),3)right(" "strip(translate(date("n",da,"s"),"-"," "),"L","0"),12)
/**[04]*********************************************************************
*
* Description: Numeric Range Parser: [ -2 19- 4 7-9 11.13.15,17 ]
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: <var>=PARSE(<range>,<min>,<max>,[sort])
*
* Where: <var> is any Legal Variable Name.
* <range> is the Numeric Range to Parse.
* <min> is the Minimum Value to Use.
* <max> is the Maximum Value to Use.
* [sort] as "s" is OPTIONAL. If specified, the items will
* also be Numerically Sorted. Duplicate Item checking
* is ONLY performed on SORTED item lists.
*
* Returns: <var> total parsed items.
* <it.0> parsed item string, parsed in SPACES.
* <it.1>
* |
* <it.?> the individual parsed item array.
*
* Note 1: This routine functions EXACTLY like CNet's own routine.
* Open ended ranges( -5 or 12- ) fully supported. Any use
* of DUPLICATE item numbers are removed, and the resulting
* it.? array contains items in NUMERICAL Order. All Non-
* Numeric items are discarded. Use the "it.0" variable
* string in conjunction with the INDEX() command for VERY
* FAST verification checking!
*
* Note 2: If sorting is NOT essential to your needs in a particular
* application, we suggest NOT using it, as it will speed up
* the parsing process CONSIDERABLY! (VERY, VERY QUICK!)
*/
transmit ">4Minimum: 0n1>4Maximum: 25n1>7Sort: ONn1"
transmit " An Example: -2 19- 4 7-9 11.13.15,17n1"
query "Enter Range: " ; tot=PARSE(result,0,25,"s")
transmit 'n1 ARexx Code: result="'result'"'
transmit "Ctot=PARSE(result,0,25,'s')n1"
transmit "Total Items: "tot ; transmit "Parsed Data: "it.0
do i=1 to tot ; transmit " Item # "right(i,2)": "it.i ; end i
exit
PARSE: procedure expose it.; arg rng,min,max,srt
it.="";c=0;it=translate(rng," ",".,")
do a=1 to words(it);c=c+1;it.c=word(it,a)
if index(it.c,"-")>0 then do;parse var it.c x"-"y
if y="" then y=max;if x="" then x=min
if x>y then do;d=x;x=y;y=d;end
if x<min|y>max|~datatype(x,"W")|~datatype(y,"W") then do;c=c-1;iterate;end
do b=x to y;it.c=b;c=c+1;end;c=c-1;end
else if it.c<min|it.c>max|~datatype(it.c,"W") then do;c=c-1;iterate;end;end
/* Leave the following SORT routine OUT if you plan on NEVER Sorting! */
if c>0 & upper(arg(4))="S" then do;do a=1 to c-1;d=a;do b=a+1 to c;d=d+1
if it.d<it.a then do;y=it.a;it.a=it.d;it.d=y;end
else if it.d=it.a then do;it.d=it.c;c=c-1;d=d-1;end;end;end;end;a=0
do i=1 to c;j=i+1;if it.i~=it.j then do;a=a+1;it.a=it.i;end;end;c=a
/* This code MUST APPEAR, whether you use the above SORT routine or NOT! */
do i=1 to c;it.0=it.0||it.i" ";end
return c
/**[05]*********************************************************************
*
* Description: CNet-like input routine, using MCI.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: <var>=INPUT(<text>,<length>,<MCI opt>,[default])
*
* Where: <text> holds the prompt text.
* <length> holds the max length of the input.
* <MCI opt> MCI input options (1=caps, 2=filename, etc.)
* (Review the MCI {I } Command for more info!)
* [default] holds the default text to appear under the
* cursor in the prompt.(OPTIONAL)
*
* Returns: <var> holds data that was input.
*/
getuser 3 ; a=INPUT("n1Who are you?n1:",20,128,result)
transmit "n1Answer="a ; exit
INPUT:;transmit arg(1)" L1305640 #"arg(4)"}I"arg(3)+4" "arg(2)"}"
getuser 70;return result
/**[06]*********************************************************************
*
* Description: Find and return BBSTEXT/BBSMENU line entry.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: <var>=BBSLINE(<file>,<line>)
*
* Where: <file> which file to use. (0=BBSMENU, 1=BBSTEXT)
* <line> holds the line number in BBSTEXT/BBSMENU.
*
* Returns: <var> holds the returned BBSTEXT/BBSMENU line entry.
*/
send bbsline(1,4) ; transmit " : line 4 in BBSTEXT"
send bbsline(0,7) ; transmit " : line 7 in BBSMENU"
exit
BBSLINE: procedure;arg ty,li;getuser 1402018+(ty*4)
ln=import(import(offset(x2c(d2x(result,8)),(li-1)*4),4),1024)
parse var ln ln"00"x .;return ln
/**[07]*********************************************************************
*
* Description: Check the CNet Amiga Version file is being run under.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: <var>=CHECKVER()
*
* Returns: <var> holds "3" if running under CNet Amiga, v3.05c,
* holds "4" if running under CNet Amiga, v4.26b+.
*
* Option: <var>=CHECKVER()-3
*
* Returns: "0" if NOT CNet/4, or "1" if CNet/4 being used.
*/
cnet=CHECKVER()
transmit "Version "cnet" of CNet!" ; transmit
cnet=CHECKVER()-3
transmit "Running on CNet/4? "word("No Yes",cnet+1)
exit
CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
return (datatype(a,"n")=1&a>"4.25")+3
/**[08]*********************************************************************
*
* Description: Check if a user is Suboperator in current subboard.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Needs: The CHECKVER() routine listed above.
*
* Usage: <var>=SUBOP(<id>)
*
* Where: <id> is the ID number of the user.
*
* Returns: <var> holds "1" if the user has Subop access, "0" if not.
*
* Notes: Compatible with BOTH 3 and 4 versions of CNet, regardless
* of the GU shift between versions. Checks ALL SIX SubOp slots
* for the user ID specified.
*/
cnet=CHECKVER()-3
getuser 40;if SUBOP(result) then transmit "Subop";else transmit "Not Subop"
exit
CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
return (datatype(a,"n")=1&a>"4.25")+3
SUBOP:;subLEN=488;subOFF=96;if cnet then do;subLEN=696;subOFF=274;end
getuser 1209388;su=result*subLEN+subOFF
getuser 2401068;so=import(x2c(d2x(result+su,8)),12)
do a=0 to 5;if Arg(1)=c2d(substr(so,a*2+1,2)) then return 1;end;return 0
/**[09]*********************************************************************
*
* Description: Checks if MCI is enabled in current subboard.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Needs: The CHECKVER() routine listed above.
*
* Usage: <var>=MCIENA()
*
* Returns: <var> holds "1" if MCI is enabled, "0" if not.
*/
cnet=CHECKVER()-3
if MCIENA() then transmit "MCI enabled in this Subboard"
else transmit "MCI disabled in this Subboard"
exit
CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
return (datatype(a,"n")=1&a>"4.25")+3
MCIENA:;subLEN=488;subOFF=243;if cnet then do;subLEN=696;subOFF=381;end
getuser 1209388;su=result*subLEN+subOFF
getuser 2401068;return c2d(import(x2c(d2x(result+su,8)),1))=0
/**[10]*********************************************************************
*
* Description: Convert from 12/24 hour time format to 12/24/min format.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: <var>=TIM(<value>,<mode>)
*
* Where: <value> is the getuser time value to convert.
* <mode> is the format to convert to:
* (12=12 Hr., 24=24 Hr., 0=Mins. Since Midnight)
*
* Returns: <var> holds the converted time value.
*
* Fixed: If an AM time was converted to 24-Hr or Minutes format, the
* returned value reflected the PM time instead of the AM time.
*/
getuser 1500000 ; tia=result
transmit "Getuser = "tia
transmit "12 hour = "tim(tia,12)
transmit "24 hour = "tim(tia,24)
transmit "Minutes = "tim(tia,0)
exit
TIM: procedure;parse arg ti,mo;ti=right(ti,6);select
when mo=12&verify(ti,"ap","M")~=6 then if left(ti,2)>12 then ti=" "left(ti,2)-12||substr(ti,3,3)"p";else ti=ti"a"
when mo=24&verify(ti,"ap","M")=6 then ti=left(ti,2)+(12*(right(ti,1)="p"))||substr(ti,3,3)
otherwise if mo=0 then ti=(left(ti,2)+(verify(ti,"ap","M")=6)*(12*(right(ti,1)="p")))*60+substr(ti,4,2)
end;return ti
/**[11]*********************************************************************
*
* Description: External Library Loader
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call LOADLIB("<library>")
*
* Where: <library> is the filename of the external library to load,
* inside of either double or single quotation marks.
*
* Returns: If library exists, it will be loaded, but if an error occurs
* during the load, you'll be told this and your file will
* immediately be terminated. (This occurs if the stated library
* is not located in your LIBS: path.)
*/
call LOADLIB("rexxsupport.library")
exit
LOADLIB: procedure ; parse arg lib ; if ~exists("libs:"lib) then do
transmit "Error loading..."lib;bufferflush;exit;end
addlib(lib,0,-30,0);return
/**[12]*********************************************************************
*
* Description: View, Enable, Disable or Toggle "Priviledge" Flags.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call PRIV(<mode>,<block>,<priv>,<name>)
*
* Where: <mode> is the KEYWORD (or first LETTER of KEYWORD)
* of the action to be performed:
*
* V or VIEW - Current Priviledge Setting.
* T or TOGGLE - Reverse Current Setting.
* E or ENABLE - Turn the Priviledge ON.
* D or DISABLE - Turn the Priviledge OFF.
*
* <block> is either a "0" for ABIT0 (the first 32 privs),
* or a "1" for ABIT1 (the second 32 priviledges).
*
* <priv> is the Priviledge Index Number found on the
* GetUser 4.00 List(The Number from 0 to 31).
*
* <name> is the ID Number, Handle, or Real Name of the
* user to perform the action on, whether they are
* ONLINE or NOT! (Uses CNet's Scratch Buffer!)
*
* Returns: <priv> holds a "Yes" if user HAS this Priviledge, or
* "No" if user DOESN'T have Priviledge.
* (Updated AFTER Action Has Taken Place!)
*
* <handle> of the user action was performed on, even if
* you entered an ID Number as the initial argument!
*
* <status> will be a "1" if data saved successfully, or
* "0" if there was a problem saving.
* (Note this variable NOT used in VIEW Mode!)
*/
call PRIV(View,0,14,Dotoran)
transmit " VIEW: Can "handle" Conference? "priv ; transmit
call PRIV(Disable,0,28,David Weeks)
transmit "DISABLE: "handle" is no longer a SysOp! status="status
call PRIV(V,0,28,1)
transmit " VIEW: Is "handle" a SysOp: "priv
call PRIV(Enable,0,28,Dotoran)
transmit " ENABLE: "handle" is now a SysOp! status="status
call PRIV(View,0,28,1)
transmit " VIEW: Is "handle" a SysOp: "priv ; transmit
call PRIV(Vi,1,20,1)
transmit " VIEW: Can "handle" Send FIDO NetMail: "priv
call PRIV(Toggle,1,20,1)
transmit " TOGGLE: Toggled ability to Send FIDO NetMail. status="status
call PRIV(View,1,20,1)
transmit " VIEW: Can "handle" Send FIDO NetMail: "priv
exit
PRIV: procedure expose priv handle status
arg mode,block,priv,id;c=left(mode,1)
if datatype(id,"n")=0 then do;findaccount id;id=result;end
if id=0 then do;transmit "Invalid Handle! Aborted!";return;end
loadscratch id;getscratch 1;handle=result
if handle="!" then do;transmit "Empty Account! Aborted!"
savescratch (-id);return;end
getscratch 1401332+block*48;a=reverse(d2c(result,4))
if c="E" then a=BitSET(a,priv);if c="D" then a=BitCLR(a,priv)
if c="T" then a=BitCHG(a,priv);priv=word("No Yes",BitTST(a,priv)+1)
if c="V" then do;savescratch (-id);return;end
setobject c2d(reverse(a));putscratch 1401332+block*48
savescratch id;status=result
return
/**[13]*********************************************************************
*
* Description: Get "Arguments" from last command.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: <var>=ARGS()
*
* Where: <var> is any legal variable name.
*
* Returns: <var> holds total number of arguments. (Max of 6)
* <arg.0> holds command text/name.
* <arg.1> holds 1st argument.
* | thru
* <arg.6> holds 6th argument.
*
* Note 1: Max length of any one argument is 61 characters, and any
* unused arguments will contain the null string.
*/
total=ARGS() ; transmit "Arguments: "total ; transmit " Command: "arg.0
do i=1 to total ; transmit " Arg "i": "arg.i ; end i
exit
ARGS: procedure expose arg. ; getuser 1202244
do i=0 to result ; getuser 1302246+(i*61) ; arg.i=result ; end
return i-2
/**[14]*********************************************************************
*
* Description: Read "Cursor Key" / "Return/Enter" Keyboard Input.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: <var> = GETCURSOR()
*
* Returns: <var> will be "8" if UP arrow was pressed.
* will be "2" if DOWN arrow was pressed.
* will be "4" if LEFT arrow was pressed.
* will be "6" if RIGHT arrow was pressed.
* will be "5" if ENTER or RETURN pressed.
*
* Note 1: Returned values are identical to the numeric keypad layout,
* so programs using this routine can be accessed by people who
* do not have directional cursor keys (A600, C64, etc.)
*
* Note 2: If key pressed was none of the above, then <var> will hold
* the actual character that WAS pressed. Returned keys will be
* UPPERCASE to mimic the same action as the GETCHAR command.
*/
START:;key=GETCURSOR();transmit key;if key~="Q" then signal START;exit
GETCURSOR: procedure;do until key~="NOCHAR";maygetchar;key=result;end
if key="1B"x then do 2;maygetchar;key=result;end;else if key="D"x then return "5";else return upper(key)
if key="A" then return "8";if key="B" then return "2";if key="C" then return "6";if key="D" then return "4"
return upper(key)
/**[15]*********************************************************************
*
* Description: Convert "UPPERCASE" to "lowercase" text.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: <var> = LOWER(<text>)
*
* Where: <var> is any valid variable name.
* <text> holds the text to be converted.
*
* Returns: <var> contains the converted lowercase text.
*/
old="The QUICK Brown fox jumped over the LAZY log!";new=LOWER(old)
transmit "Mixed Text: "old;transmit "Lower Text: "new;exit
LOWER:;return translate(ARG(1),xrange("a","z"),xrange("A","Z"))
/**[16]*********************************************************************
*
* Description: Pauses output for "x" number of seconds the RIGHT way!
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: call PAUSE(<seconds>)
*
* Where: <seconds> is the number of seconds to wait.
*
* Note: This routine uses the DELAY() function, located in the
* support library "rexxsupport.library". See the included
* intro for more info on using this library.
*/
transmit "Print this line, now wait 5 seconds..."
call PAUSE(5);transmit "Now print this line!";exit
PAUSE:;a=delay(Arg(1)*50);return
/**[17]*********************************************************************
*
* Description: Checks for "Loss of Carrier" in your Doors!
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage 1: <var> = CHECK(<result>)
*
* Usage 2: call CHECK
*
* Where: <var> is any valid variable name.
*
* Note 1: Use [Usage 1] after you INPUT data using these commands:
* GETCHAR, RECEIVE, PROMPT, the MCI {i } Command, etc.
*
* Note 2: Use [Usage 2] to simply CHECK for CARRIER. It's a good
* idea to use a few of these calls in places where your
* program may be doing numerous things WITHOUT the user
* having to enter any input.
*/
getchar;a=CHECK(result);transmit a;call CHECK;transmit "It still works";exit
CHECK:;if ARG() & ARG(1)~="###PANIC" then return ARG(1)
getcarrier;if result="TRUE" then if ARG() then return ARG(1);else return
/* You may wish to call SAVE DATA routines here, reenable MORE
prompts, unmuffle or unhide the port, etc. */
logentry "Lost Carrier!!";bufferflush;exit
/**[18]*********************************************************************
*
* Description: An informative "Error Checking" routine.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: To use this routine, place it somewhere near the end of
* your program, then at the top of your program, normally
* right after your "options results" statement, place this
* line of text:
*
* signal on SYNTAX ; signal on ERROR ; signal on IOERR
*
* Returns: When an error is encountered, your program will halt. The
* user will be shown the error number and description, as well
* as the naame of the file the error occurred in. In addition,
* the line number and actual code found ON that line will also
* be displayed. Any CTRL-Y or CTRL-Q MCI codes contained ON the
* line will be rendered using \ and { for safety's sake. A copy
* of this same line will be copied to your "calls" log, or to
* an "ARexx_Says" log, if you have one defined.
*
* Note 1: Each line is formatted for 46 characters, the maximum width
* stated on line 845 of BBSTEXT for inclusion into the logs.
* If you include MCI/ANSI color codes into these lines, then
* change the "%-.45s" on line 845 of BBSTEXT to read "%s".
*/
signal on SYNTAX ; signal on ERROR ; signal on IOERR
average=(10+20+30+40/4 /* Causes the "Unbalanced Parenthesis" error. */
exit
SYNTAX:;ERROR:;IOERR:;e1=' Error: 'rc' ('errortext(rc)')';e2=' Line: 'left(sigl,4)'File:'
getuser 1311992;a=result;getuser 1311960;b=result;c='"'a||b'"';e2=e2' 'c;transmit e1;transmit e2;logentry e1;logentry e2
e=translate(sourceline(sigl),"\{","");do while e~='';e3='Source: 'left(e,37);transmit e3;logentry e3;e=substr(e,38);end;bufferflush;exit
/**[19]*********************************************************************
*
* Description: Positions cursor for printing anywhere on the screen.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: <command> AT(<row>,<col>)"<text>"
*
* Where: <command> could be TRANSMIT, SENDSTRING, QUERY, etc.
* <row> is the row text will print on.
* <col> is the column text will start at.
* <text> is the text to be printed, within quotes.
*
* Returns: will print given text at the given screen position.
*/
transmit "f1"
transmit AT(1,1)"Will this work?"AT(10,10)"Hello World"
do i=3 to 13 ; sendstring AT(i,50)"Looped Text; Iteration "i-2 ; end
query AT(15,25)"Press ENTER Now..."
exit
AT:;return ""arg(1)";"arg(2)"H"
/**[20]*********************************************************************
*
* Description: Horizontal Text Scroller Number 1.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call SCROLLER(clr,ro1,co1,ro2,co2,dir,"txt")
*
* Where: <clr> Clear Screen First? (0=No, 1=Yes)
* <ro1> Row to START scrolling at.
* <co1> Column on "ro1" to START scrolling at.
* <ro2> Row to STOP scrolling at.
* <co2> Column on "ro2" to STOP scrolling at.
* <dir> Scroll Direction: 0=Left, 1=Right, 2=Alternate
* <txt> Text to be Scrolled, inside DOUBLE quotes.
*
* Results: The <txt> line will be scrolled between the two columns
* on each ROW individually, starting at "ro1" and ending
* at "ro2". You can STOP the Scrolling prematurely by
* pressing any key.
*/
transmit "f1cf8H"copies("*",44)"18H*61H*18H"copies("*",44)"c9"
call SCROLLER(0,10,20,10,60,2,"CNet Amiga ToolKit, v3.00 Compiled by Dotoran of Frontiers!")
exit
SCROLLER: procedure;parse arg clr,ro1,co1,ro2,co2,dir,txt;txt=copies(" ",co2-co1)||txt" ";if clr then cls
do i=ro1 to ro2;lo=1;in=1;hi=length(txt);if dir=2 then d2=(i/2=i%2);if d2=0 then do;lo=hi;hi=1;in=-1;end
do j=lo to hi by in;maygetchar;if result~="NOCHAR" then leave i;ch=substr(txt,j,co2-co1);transmit ""i";"co1"H"ch;end j;end i
return
/**[21]*********************************************************************
*
* Description: Horizontal Text Scroller Number 2.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: call SCROLL(<row>,<"txt">)
*
* Where: <row> is the Screen Row to be Scrolled.
* <"txt"> is the Text Line to be Scrolled, within quotes.
*
* Note 1: You can use three special characters inside your text
* string to affect the SPEED at which the text is shown:
*
* Press ALT-1 (¹) for Fastest Speed.
* Press ALT-2 (²) for Medium Speed.
* Press ALT-3 (³) for Slowest Speed.
*
* This routine uses the DELAY() command to create the speeds,
* which means the "rexxsupport.library" is also needed.
*
* Note 2: The text string will be scrolled from RIGHT to LEFT,
* starting at the right edge of the user's default Line
* Length(40,80,etc.) You can abort the scrolling at any
* time by pressing any key.
*
* Note 3: An interesting alternate use for this routine is to
* scroll the EXISTING text on the screen. To do this,
* specify the "row" you wish to Scroll, then use "" as
* the Text to Scroll. Nothing NEW will appear on the
* screen, but any EXISTING characters ON that row will
* be scrolled off the left side of the screen!
*/
text="²CNet Amiga ToolKit, v3.00 compiled by >> Dotoran of Frontiers << "
text=text||"³³³³³³³³¹ This is a test of the SCROLL subroutine"
call SCROLL(15,text);exit
SCROLL: procedure;parse arg line,text;sp=2;getuser27;ll=result-1
do a=1 to length(text)+ll;ch=substr(text,a,1);if index("¹²³",ch)>0 then sp=translate(ch,"246","¹²³")
else sendstring ""line";0HP"line";"ll"H"ch;call delay(sp);maygetchar;if result~="NOCHAR" then leave;end
return
/**[22]*********************************************************************
*
* Description: Read the joystick(s) and firebutton(s).
*
* Author(s): Thomas - Dreamline Amiga BBS +45 3582-7043
* PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: <var>=JOY(<joynum>)
*
* Where: <joynum> is the Joy port (0=Port1, 1=Port2)
*
* Returns: <var> holds keypad values for directions, "0" if none.
* and value+10 if the firebutton was pressed.
*
* Note 1: This routine will allow the joystick(s) to be used from the
* LOCAL port only. It will NOT function from remote.
*
* Note 2: Press your ENTER/RETURN key to exit the example given below.
*/
do until key="0d"x ; maygetchar; key=result
transmit "f1"JOY(1) ; end ; exit
JOY: procedure;arg w;a=import(d2c(14675978+w*2,4),2);b=~bittst(import("00BF E001"x,1),6+w)*10
return x2d(translate(c2x(b2c(bittst(a,8)bittst(a,9)bittst(a,0)bittst(a,1))),"963147","B31EC4"))+b
/**[23]*********************************************************************
*
* Description: First attempt at MOUSE capability. (95% Complete!)
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: <var> = MOUSE(<row>,<col>,<length>)
*
* Where: <var> is any valid variable name.
* <row> is the ROW the button is located on.
* <col> is the COLUMN the button STARTS at.
* <length> is the LENGTH(in Columns) of this button.
*
* Returns: <var> will be "1" if the Mouse Button WAS pressed.
* will be "0" is the Mouse Button WASN'T pressed.
*
* Note 1: This routine is lacking the ability to catch when you
* "double-click" on a button, and will not ALWAYS catch
* when you DO click on a button. If anyone can offer us
* a better MOUSE() routine, please send us a copy and
* we'll include it in the next version(with your name)!
*
* Note 2: The following example program can also be aborted by
* pressing any key, instead of using the mouse.
*/
transmit "f1Hz7c4 Press Me z060Hz6cb QUIT z0"
do until b1+b2>0;b1=MOUSE(5,5,12);b2=MOUSE(20,60,8);maygetchar
if result~="NOCHAR" then do;transmit "A Keyboard Key was pressed.";exit;end;end
if b1=1 then transmit "`Press Me' was pressed.";if b2=1 then transmit "`QUIT' was pressed."
exit
MOUSE: procedure;getuser 1202140;xc=result%8+1 ; getuser 1202142;yc=(result-11)%8+1
return arg(1)=yc & xc>=arg(2) & xc<arg(2)+arg(3) & bittst(import("00BF E001"x,1),6)=0
/**[24]*********************************************************************
*
* Description: Disable or Enable the MORE? prompt, regardless of setting!
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage 1: call NOMORE
*
* Usage 2: call MORE
*
* Before Use: Add this line somewhere at the START of your file, so that
* it will only be run ONCE:
*
* getuser 1100454;oldmore=result
*
* After Use: When you're ready to LEAVE your file, place this line BEFORE
* every occurrance of the command EXIT:
*
* setobject oldmore;putuser 1100454
*
* Note 1: Use [Usage 1] when you wish to DISABLE the More? Prompt,
* Use [Usage 2] when you wish to ENABLE the More? Prompt.
*
* Note 2: Be sure to add the above two lines to insure the user's
* chosen More? setting is returned to it's original setting,
* especially within an Error Check routine you may be using!
*/
getuser 1100454;oldmore=result
transmit "With the More? Prompt disabled..."
call NOMORE ; sendfile "systext:help/mci"
transmit "Now with More? Prompt enabled..."
call MORE ; sendfile "systext:help/mci"
setobject oldmore;putuser 1100454
exit
NOMORE:;sendstring "L1100454 #0}";return
MORE:;sendstring "L1100454 #1}";return
/**[25]*********************************************************************
*
* Description: Muffle ALL ports, regardless of setting!
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call MUFFLE
*
* Before Use: Add this line somewhere at the START of your file, so that
* it will only be run ONCE:
*
* getuser 1101745 ; muffle=result ; call MUFFLE
*
* After Use: When you're ready to LEAVE your file, place this line BEFORE
* every occurrance of the command EXIT:
*
* if muffle=0 then call MUFFLE
*
* Note 1: Use "call MUFFLE" as a command in your file as well to give
* the USER the option of toggling the Muffle Setting.
*
* Note 2: Be sure to add the above two lines to insure the user's
* chosen Muffle setting is returned to it's original setting!
*/
getuser 1101745;muffle=result;bbscommand "who";call MUFFLE
bbscommand "who";if muffle=0 then call MUFFLE ; bbscommand "who"
exit
MUFFLE:;if muffle=0 then bbscommand "MU *";return
/**[26]*********************************************************************
*
* Description: Extended SelectFile Routine.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: var=SELFILE(<file>,<bcost>,<fcost>,<kill>)
*
* Where: <file> is the file to add to the Select Buffer (incl. Path)
* <bcost> "0" if the byte is FREE, "100" to deduct 1*bytesize
* "150" to deduct 1.5*bytesize etc.
* <fcost> "0" if the file is FREE, "1" for file price of 1
* "2" for file price of 2 etc.
* <kill> "0"=Don't Kill, "1"=Kill when downloaded,
* "2"=Kill when dl/unselect, "3"=Kill when unselected.
*
* Returns: <var> "0" If selectbuffer is full.
* "1" If selecting was sucessfull.
*/
if SELFILE("s:startup-sequence",200,2,0) then transmit "File added to selectbuffer"
else transmit "Sorry - your selectbuffer is full!"
exit
SELFILE: procedure;arg np,bco,fco,ki;getuser 1209644;nu=result;getuser 2407246;if nu=result then return 0
pa=left(np,max(lastpos(":",np),lastpos("/",np)));na=substr(np,length(pa)+1);si=word(statef(np),2)
sh=x2c(d2x(si,8))left(na,32,"00"x)left(pa,96,"00"x)copies("00"x,7)x2c(d2x(ki,2))x2c(d2x(si*bco%100,8))x2c(d2x(fco,4))copies("00"x,6)copies("FF"x,4)
getcarrier;if result~="TRUE" then exit;getuser 1401978;call export(x2c(d2x(result+nu*156,8)),sh);setobject nu+1;putuser 1209644;return 1
/**[27]*********************************************************************
*
* Description: Add line of text to specified LOG file.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call LOG("<name>","<text>","[path]")
*
* Where: <name> is the NAME of the LOG file to add to.
* <text> is the TEXT line to be added to the log.
* [path] if present, this specifies an alternate path to
* SAVE the LOG to. Defaults to "SysData:Log/"
*/
call LOG("test_log","As found in Sysdata:Log/ path.")
call LOG("test_log","As found in RAM: path!!","ram:")
sendfile "sysdata:log/test_log" ; sendfile "ram:test_log"
exit
LOG: procedure;parse arg n,t,a;if Arg()=2 then a="SysData:Log/";n=a||n
call open(f9,n,substr("wa",exists(n)+1,1));call writeln(f9,t)
call close(f9);return
/**[28]*********************************************************************
*
* Description: Check Port Menu(s) Checkmark Status.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: call PMENU(<port>,<item>)
*
* Where: <port> is the PORT to check. (Use 100 for ALL Ports).
* <item> is the item to check. Although you can type as much
* of the menu item text as you wish, only the first
* letter matters, as shown below:
*
* For CNet, v3.05c's Routine: For CNet, v4.26b's Routine:
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~
* 's' to check "Sysop is in". 'd' to check "Doors closed".
* 'n' to check "No new users". 'f' to check "Files closed".
* 'u' to check "UD base closed". 'm' to check "Msgs closed".
* 'p' to check "Pfiles closed". 'n' to check "No new users".
* 'b' to check "Base closed". 's' to check "Sysop is in".
*
* Returns: 0 if there is NO checkmark shown.
* 1 if there IS a checkmark shown.
*
* Note: There are TWO DIFFERENT "PMENU" routines listed below. Not
* only did the GetUser change between versions, but the ORDER
* of the Menu Flags changed as well. Make sure to use the right
* version, depending on your CNet version. If creating a dual
* compatible program, use the CHECKVER() routine above, then
* include BOTH routines given below, perhaps RENAMING them to
* "PMENU3" and "PMENU4", calling the needed routine, based on
* your returned result from CHECKVER().
*/
/* Example code for CNet, v4.26b */
transmit "Menu for Port: 0n1"
call PMENU(0,d) ; transmit " Doors closed: "word("No Yes",result+1)
call PMENU(0,f) ; transmit " Files closed: "word("No Yes",result+1)
call PMENU(0,m) ; transmit " Msgs closed: "word("No Yes",result+1)
call PMENU(0,n) ; transmit " No new users: "word("No Yes",result+1)
call PMENU(0,s) ; transmit " SysOp is in: "word("No Yes",result+1)
exit
PMENU: procedure;arg p,m;m=index("DFMNS",left(m,1))-1
getuser 2124552+(p*24);return bittst(d2c(result),m)
/* Example code for CNet, v3.05c */
transmit " Menu for Port: 0n1"
call PMENU(0,s) ; transmit " SysOp is in: "word("No Yes",result+1)
call PMENU(0,n) ; transmit " No new users: "word("No Yes",result+1)
call PMENU(0,u) ; transmit "UD base closed: "word("No Yes",result+1)
call PMENU(0,p) ; transmit " Pfiles closed: "word("No Yes",result+1)
call PMENU(0,b) ; transmit " Base closed: "word("No Yes",result+1)
exit
PMENU: procedure;arg p,m;m=index("SNUPB",left(m,1))-1
getuser 2121864+(p*24);return bittst(d2c(result),m)
/**[29]*********************************************************************
*
* Description: Send Text File as CNet MAIL to specified User.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call MAIL(<id>,"<subj>","<file>")
*
* Where: <id> can be the ID Number, Handle or Real Name of the
* user in which you'd like to send the mail item to.
* If a Handle or Real Name is specified, enclose it
* in double quotation marks.
*
* <subj> is the Subject to name the Mail Message.
*
* <file> if the path/filename of the text file to send.
*
* Returns: 0 if mail send FAILED. (File Not Found/Box Closed or Full)
* 1 if mail was sent successfully.
*
* Notes: The example given below utilizes a text file created using
* the "BUGS" command, a BBSMenu enhancement found in the TEXT
* ToolKit.
*/
if MAIL(1,"CNet Bugs","uploads:cnetbugs") then transmit "Mail sent!"
else transmit "Mail send failed!"
exit
MAIL: procedure;parse arg id,subj,file;findaccount id"!";id=result
if ~exists(file) then do;transmit "File not found!";return 0;end
loadeditor file;setmailsubj subj;writemail id;return result
/**[30]*********************************************************************
*
* Description: Send a CNet/4 "File Attach" EMail Message to specified User.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Note: This routine ONLY runs under CNet, v4.26b!
*
* Usage: call FMAIL(<id>,"<subj>","<text>","<file>")
*
* Where: <id> can be the ID Number, Handle or Real Name of the
* user in which you'd like to send the mail item to.
* If a Handle or Real Name is specified, enclose it
* in double quotation marks.
*
* <subj> is the Subject to name the Mail Message. Enclose in
* double quotes if subject contains SPACES.
*
* <text> is a text file that will become the BODY of the EMail
* Message. Enclose the text in double quotes if it will
* contain SPACES in the filename.
*
* <file> is the path/filename of the text file to attach to
* the email message created. Again, if the name will
* contain SPACES, enclose it in double quotes.
*
* Returns: 0 if mail FAILED. (Text or File Not Found)
* 1 if command string sent successfully.
*
* Notes: The example given below utilizes a text file created using
* the "BUGS" command, a BBSMenu enhancement found in the TEXT
* ToolKit. Also, no internal checking is done on whether the
* mail send itself was successful. This routine creates the
* needed command string, which is then sent to CNet's Keyboard
* Buffer. If the user has the VisEd set as their default, then
* the appropriate extra commands are prepended and suffixed to
* the mailsend commands to temporarily switch to the LineEd, so
* the proper dot(.) commands can be executed.
*/
if FMAIL(1,"CNet Bugs","dweeks:for_ray","uploads:cnetbugs") then
transmit "Mail sent!" ; else transmit "Mail failed!"
exit
FMAIL: procedure;parse arg id,subj,text,file;findaccount id"!";id=result
if ~exists(text)|~exists(file) then do;transmit "File error!";return 0;end
getuser 1100645;ed=result;keys="";if ed then keys="ep`9`0``"
keys=keys"ms`"id"```"subj"`F`"file"`.g"text"`.s`"
if ed then keys=keys"ep`9`1``";addkeys (keys)
return 1
/**[31]*********************************************************************
*
* Description: Send a System OLM (OnLine Message) to the current user.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Inputs: This routine uses the CHECKVER() routine above to define the
* "cv" variable, which the SENDOLM() routine uses. You also need
* to define variables "handle", "port", and "uid" before calling
* this routine.
*
* Routine works on BOTH v3.05c and v4.26b of CNet Amiga!
*
* Usage: call SYSOLM(<msg>)
*
* Where: <msg> is the Message to appear as a "System OLM", enclosed
* in double quotation marks.
*
* Option: If you wish to add MCI-Commands into your OLM-text, then you
* need to REMOVE the \@1 from the END of line number 920 in your
* BBSTEXT file, so it reads:
*
* 920: \n1\c7**** System Message\n1\a1
*
* Remember, the \'s are really CONTROL-Y's.
*
* Note: The \'s and {'s used in the example given below are actually
* Control-Y's and Control-Q's, used to show the COLORIZED OLM
* ability of this routine. Make the proper substitutions when
* you try this routine on your ends, as well as modifying Line
* 920 as stated above.
*/
getuser 1 ; handle=result ; getuser 23 ; port=result
getuser 40 ; uid=result ; cv=CHECKVER()
call SENDOLM("\c6Hello \ca{V1}\c6, How are you this \cb{V46}\c6?!?")
exit
CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
return (datatype(a,"n")=1&a>"4.25")+3
SYSOLM:;parse arg text;getuser 2307346;path=result;z="00"x;a="";v1=""
if exists(path"_olm"port) then a="a";name=path"_"a"olm"
a="w";t=0;if exists(name) then a="a";if cv=4 then v1=d2c(uid,4)
h=v1||left(handle,26,z)copies(z,28)text"0A1A0A"x;n=name||port
if cv=3 then h=overlay(d2c(1),h,31,1)
call forbid();call open(f1,n,a);call writeln(f1,h);call close(f1)
call permit();setobject "0";putuser 1409746
getuser 1101743;olm=result+1;setobject olm;putuser 1101743
return
/**[32]*********************************************************************
*
* Description: Add keystrokes to other ports from present port.
*
* Author(s): Aunt Bea - Blue Moon BBS +1 716/871-9866
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call ADDEM(<port>,"<keys>",<mode>)
*
* Where: <port> is the port number to add keystrokes to.
* <keys> are the keystrokes to add, within double quotes.
* <mode> as "1" and the user will see them,
* as "2" and the user will NOT see them.
*
* Returns: Keystrokes will be entered into the command stream on stated
* port. Nothing will be returned on your port.
*
* Example1: call ADDEM(2,"o!",2) will LogOff user on Port 2 without them
* knowing what just happened!
*
* Example2: call ADDEM(1,"ep;9;1;;",1) will set the Visual Editor as the
* default editor for user on Port 1
* allowing them to see the command
* being processed on their screens!
*
* Notes: The serial port is DISABLED when you choose for the user NOT
* to be able to see what commands you just entered. For this
* reason, YOU on the LOCAL port WILL see the commands being
* executed, however the text output is NOT sent over the serial
* port.
*/
query " Send to which port? ";port=result
query "Add which keystrokes? ";keys=result
sendstring " Disable serial port? ";getchar;a=result
if a="Y" then mode=2;else mode=1;transmit word("No Yes",mode)
call ADDEM(port,keys,mode)
exit
ADDEM: procedure;parse arg po,ke,mo;address ("CNETREXX"po)
modem mo;addkeys ke"`";modem 1;return
/**[33]*********************************************************************
*
* Description: A QUICK "Who" for SysOps, listing Access Group Number.
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* Aunt Bea - Blue Moon BBS +1 716/871-9866
***************************************************************************
*
* Inputs: The CHECKVER() routine is used to create 3.05c/4.26b CNet
* compatibility.
*
* Usage: call WHO
*
* Returns: Displays all loaded ports, listing port number, handle,
* access group, speed, from and where info.
*/
cnet=CHECKVER()-3
call WHO
exit
CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
return (datatype(a,"n")=1&a>"4.25")+3
WHO:;transmit "r1# "left("Handle",21)left("AG SPD From",38)left("Location",16)"r0"
getuser word("2225094 2227782",cnet+1);hp=result;do po=0 to hp;getportid po;pi=result;if pi=-1 then iterate
loadscratch pi;savescratch (-pi);getscratch 1;ha=result;getscratch 15;ac=result;getwhere po;wh=result;getscratch 1201214;cp=result%10
getscratch 4;fr=result;transmit left(po,3)left(ha,21)left(ac,3)left(cp,4)left(fr,31)left(wh,16);end
return
/**[34]*********************************************************************
*
* Description: View "port" log of specified port. (Pre "calls" log).
*
* Author(s): Aunt Bea - Blue Moon BBS +1 716/871-9866
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call LOGPO(<port>)
*
* Where: <port> is the port number to view the log of.
*
* Returns: Displays the "calls" log entry for this user, as it looks
* so far. By activating other log processes through CONFIG
* without assigning other log names for them, you can see
* what the user has done up to that point this call.
*/
query "Port to view log of? ";po=result;call LOGPO(po);exit
LOGPO: procedure;arg p;if exists("sysdata:log/port"p) then sendfile "sysdata:log/port"p
else transmit "Port "p" log not found.";return
/**[35]*********************************************************************
*
* Description: Send Line Noise to a port (Ability to kick them off too!)
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* Aunt Bea - Blue Moon BBS +1 716/871-9866
*
***************************************************************************
*
* Inputs: Define a "cv" variable by calling the CHECKVER() routine to
* determine the correct CNet Version!
*
* Usage: call LNOISE(<port>,<drop>)
*
* Where: <port> is the port number to send Line Noise to.
* <drop> as "1" will also DROP CARRIER on that port,
* as "0" will NOT drop carrier. Just Annoy! hehe
*
* Returns: A check is done to make sure that the user using this routine
* is a Conference Controller and that the port number entered
* is a valid number. A check is also done to make sure the
* user issuing the Line Noise doesn't lose carrier themselves.
*/
query "Send Line Noise to which Port? ";port=result
sendstring "Should it also Drop Carrier? ";getchar;a=result
if a="Y" then drop=1;else drop=0;transmit word("No Yes",drop+1)
cv=CHECKVER()-3 ; call LNOISE(port,drop)
exit
CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
return (datatype(a,"n")=1&a>"4.25")+3
LNOISE:;arg p,d;a=time("s");getuser 1400660;if bittst(reverse(d2c(result,4)),15)=0 then exit
if p="###PANIC" then exit;getuser word("2225094 2227782",cv+1);hp=result;if p>hp|p<0|datatype(p,"n")=0 then exit
a.0=d2c(6)"s1ou797¾s07i7";a.1=d2c(6)"¾";a.2=d2c(6)"«¾«¾"d2c(6)"y«¾®«¾7r"
a.3="®6¾½¤80y9ohj;"d2c(12)";";a.4=d2c(13)":OJl;;ø·";a.5=d2c(12)d2c(8)"¡¾½¼©w1µþð65 ®ð7"
a.6="54®© 7 08o 7pi"d2c(8)"·¡";a.7="¾µ¤P*o¡¤þ·7ue64s¼¢³ G";a.8="DXc ."d2c(11)"LJ. ;o8"
a.9="n"d2c(12)"¡¾½#©ð¢e";a.10="¾¼43 5"d2c(4)"i6yYth98h¤«y)*Ou"d2c(7)"9i76y"
a.11=d2c(6)"¡¾½f«¾s1¼®®«¾5»·y9i-»«s0098þ·r·«¾«¾«¾¡";a.12="utg9797n1"d2c(2)"¾þ"
a.13="T«¡¾þ®hgb¸ºmnªº vh,"d2c(13)"vbvÇn";a.14=d2c(2)" c Vxgedy";a.15="trd¡¤w1¡µðµþðç "d2c(4)"dd"
a.16=""d2c(4)"½þµðn1"d2c(4)"þµð";a.17="¤þ¡µðiy"d2c(6)""d2c(6)d2c(6)""d2c(6)"ð";a.18=d2c(6)d2c(4)d2c(6)"uy"d2c(7)
address ("CNETREXX"p);do random(4,18);l=random(0,18);sendstring a.l;end
if d=1 then dropcarrier;do random(4,18);l=random(0,18);sendstring a.l;end
bufferflush;return
/**[36]*********************************************************************
*
* Description: UnLock User Accounts (That May NOT Have Been Previously!)
*
* Author(s): Aunt Bea - Blue Moon BBS +1 716/871-9866
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call UNLOCK(<id>)
*
* Where: <id> is the ID number of the account to UnLock. This can
* also be specified as the Handle or Real Name of the
* user whose account you wish unlocked. Use "0" to
* UnLock ALL accounts on your system.
*
* Returns: Will tell you when it's done.
*
* WARNING!: You should ONLY run this file when there are NO OTHER ARexx
* tasks running simultaneously, as if one of these other tasks
* were to LOCK an account, Unlocking it prematurely may cause
* THAT task to fail or crash. This routine is meant as a FIX
* for any files using LOADSCRATCH where you believe there to
* be a problem with it not UNLOCKING the accounts.
*/
query "Account to UnLock? [0=ALL]: ";p=result;call UNLOCK(p);exit
UNLOCK: procedure;arg p;getuser 2400088;ta=result;if p=0 then do i=1 to ta;savescratch (-i);sendstring ".";end i
else do;findaccount p;id=result;savescratch (-id);end;transmit "Account(s) unlocked.";return
/**[37]*********************************************************************
*
* Description: Replace <input> with <output> within string of <text>.
* (A bit like the AREXX's TRANSLATE command, but NOT limited
* to replacing text of equal length)
*
* Author(s): PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: <var>=REPLACE(<text>,<input>,<output>)
*
* Where: <text> holds the text to do replacement on.
* <input> is the text you want to replace.
* <output> is the text you want to appear instead of <input>.
*
* Returns: <var> holds the replaced <text>.
*/
text="My handle is PMK, and this is a test!! - PMK!!"
transmit "n1Before replace: "text ; getuser 1 ; handle=result
transmit "n1 After replace: "REPLACE(text,"PMK",handle)
exit
REPLACE: procedure;parse arg a,b,c;d=index(a,b);do while d~=0
a=insert(c,delstr(a,d,length(b)),d-1);d=index(a,b);end;return a
/**[38]*********************************************************************
*
* Description: Find and Return or Verify BBSMENU Line(s).
*
* Author(s): Dotoran - Frontiers BBS +1 716/823-9892
* PMK - (Peter no longer runs a bbs...)
*
***************************************************************************
*
* Usage: <var>=BMTXT(<menu>,[<line>])
*
* Where: <menu> BBSMENU Menu Number.
* <line> Line Number in Menu OR command to Verify.
*
* Returns: <var> when <line> is NUMERIC, holds the returned BBSMENU
* Menu Line entry. If <line> is text, a "1" is returned
* if a command by that name exists in that menu. ("0"
* is returned if no such command exists. If <line> is
* omitted, the number of lines in that BBSMENU Menu are
* returned in <var>, while the "BMT.<x>" array will hold
* the actual BBSMENU listing.
*/
transmit "Menu # 7, Item 6: "BMTXT(7,6)
transmit "Menu # 12, Item 3: "BMTXT(12,3)
transmit "Menu # 30, Item 8: "BMTXT(30,8)
transmit "Menu # 2, Help?: "word("Yes No",(BMTXT(2,"Help")>1)+1)
transmit "Menu # 2, Vote?: "word("Yes No",(BMTXT(2,"Vote")>1)+1)
transmit "n1Complete Menu # 8: n1"
do d=0 to BMTXT(8);transmit right(d,3)") "bmt.d;end d;exit
BMTXT: procedure expose bmt.;b=ARG(1)*2;dt=datatype(ARG(2),"N");getuser 2401064
t=import(x2c(d2x(result,8)),220);parse var t 13 p +4 =b+21 s +2 =b+121 l +2
if ARG()=2&ARG(2)<=c2d(l)&dt then do;m=import(import(offset(p,4*(c2d(s)+ARG(2))),4),512)
parse var m t"00"x;return translate(t,"\{","");end;c=0
do a=c2d(s) to (c2d(s)+c2d(l)-1);m=import(import(offset(p,4*a),4),512)
parse var m t"00"x;bmt.c=translate(t,"\{","")
if ~dt & index(upper(bmt.c),upper(ARG(2)))~=0 then return 1
c=c+1;end;return c-1
/**[39]*********************************************************************
*
* Description: Clears a specific port, by dumping the user. Similar to
* the DROPCARRIER command, but allows different log entries.
*
* Author(s): PMK - (Peter no longer runs a bbs...)
* Dotoran - Frontiers BBS +1 716/823-9892
*
***************************************************************************
*
* Usage: call DUMPUSER(<port>,<logoff>,[<quick>])
*
* Where: <port> is the port number to clear. (dumps user)
* <logoff> as "0" shows "TIME LIMIT EXCEEDED" in the log.
* as "1" shows "AUTO CALL-BACK FAILED" in the log.
* as "2" shows "IDLE TIME EXCEEDED" in the log.
* as "3" shows "LOST CARRIER" in the log.
* as "4" shows "INSTANT LOGOFF" in the log.
* as "5" shows "NORMAL LOGOFF" in the log.
* as "6" shows "RE-LOGON" in the log.
* as "7" shows "$ BALANCE TOO LOW" in the log.
* as "8" shows "DUMPED BY SYSOP" in the log.
* as "9" shows "FILE XFER AUTO-LOGOFF" in the log.
* as "10" shows "MCI % COMMAND" in the log.
* as "11" shows "TERM LINK" in the log.
* <quick> if "1", a quick logoff is performed. (similar to
* the normal "O!" - No SYS.END is displayed.)
*
* Notes: A check is done to make sure that the port number entered
* is a valid number, and the port is occupied by a user.
*
* If a type "6", RE-LOGON, is specified, the user will LogOff,
* and then BACK on, using Re-Logon, EVEN if the user does NOT
* have the "RELOGON" priviledge flag set! (kinda cool!)
*
* Returns: "0" if the dumping failed (no user on port, bad port etc.)
* "1" if the user was successfully dumped.
*/
call dumpuser(0,3) /* Dump Port 0, due to "LOST CARRIER" in the log! */
/* <or> */
call dumpuser(2,6,1) /* Dump Port 2 initiating a "RE-LOGON" process! */
exit
DUMPUSER:procedure;arg p,d,q;if q~=1 then q=0;rl="";if d=6 then rl="L1109806 #2}"
getportid p;if result=-1|~datatype(p,"W")|~datatype(d,"W")|d<0|d>11 then return 0
address ("CNETREXX"p);sendstring "L1109799 #"q"}L1200022 #"d"}"rl"L1109807 #1}";addkeys "`";return 1
/**[40]*********************************************************************
*
* Description: EnCode & DeCode text strings, using a Numeric Key. Given the
* desired text string, along with a numeric key, the text will
* be encoded using a specific code string. The text can then
* only be decoded using the same numeric key.
*
* Author(s): Dotoran - Frontiers BBS +716 823-9892
*
***************************************************************************
*
* Usage: To EnCode a text string, use the ENCODE() function:
*
* <var> = ENCODE( <text> , <key> )
*
* Where: <var> is the variable the encoded text will be placed.
* <text> is the text string(or variable holding text string)
* that needs to be encoded.
* <key> is a numeric value between 1 and 94. Values below 1
* or greater than 94 will return INCORRECT results!
*
* Usage: To DeCode a coded text string, use the DECODE() function:
*
* <var> = DECODE( <text> , <key> )
*
* Where: <var> is the variable the decoded text will be stored in.
* <text> is the ALREADY CODED text string you wish to DeCode.
* This can also be a variable containing coded text.
* <key> is the SAME numeric key you used to MAKE the initial
* coded string. If you do NOT use the SAME numeric key,
* then the text will NOT be DeCoded correctly.
*
* Notes: This technique comes in real handy when you wish to encrypt
* data before saving it to disk. The data can then be decoded
* as it is read in the next time it is needed.
*/
query " Enter the text to Encode: ";a=result
query "Key value(between 1 and 94): ";k=result
y=ENCODE(a,k);z=DECODE(y,k);transmit
transmit "Entered Text: "a
transmit "EnCoded Text: "y
transmit "DeCoded Text: "z
exit
ENCODE:procedure;parse arg t,k;a=xrange(" ","~")
k=xrange(d2c(32+k),"~")xrange(" ",d2c(31+k));return translate(t,a,k)
DECODE:procedure;parse arg t,k;a=xrange(" ","~")
k=xrange(d2c(32+k),"~")xrange(" ",d2c(31+k));return translate(t,k,a)
/**[41]*********************************************************************
*
* Description: Guideline Entry-text for Mail (and File) Subboards.
* This will display a small bar, with some of the current
* subboard settings, like Sigs allowed?, Handles allowed?,
* Subboard Inactivity days. - Add it to your entry texts.
*
* Screenshots: Guidelines4BEV1.iff and Guidelines4BEV2.iff
*
* Author(s): Dotoran - Frontiers BBS +716 823-9892
*
***************************************************************************
*
* Usage: There are three versions of the Guideline file for BOTH CNet
* versions, an Ascii, ANSI, and IBM-ANSI Beveled. Choose the
* version you wish to use, then use it's filename in place of
* the <guidelines> tag used in the lines below.
*
* These stand alone ARexx files can be used in one of two ways:
*
* 1. You can launch them from within a base's "sys.entry" file by doing
* the following:
*
* - Enter the base in question, then type ENTRY.
* - Once in the "sys.entry" editor, type the following line:
*
* {#0<path><guidelines>}
*
* Where: <path> is the location you chose to STORE the
* ARexx Base Guidelines file.
*
* <guidelines> is the filename of the Base Guidelines
* you'd like to use.
*
* - Save the editor and you're done. You can create additional
* "sys.entry" files for additional bases.
*
* 2. Add the following code to the BEGINNING of Line 316 in BBSText:
*
* {#0<path><guidelines>}
*
* So the completed line looks like this:
*
* {#0<path><guidelines>\n1\c7*Subboard \c6(\c7{v48}\c6 <--
* ) \c7{v49}\n1\q1
*
* This method will display the selected Guidelines upon entry into
* EVERY base created on your system.
*
* Options: Method 1 above offers another advantage over method 2, as
* you also have the ability of specifying alternate Guideline
* designs in different bases. (For instance, perhaps you'd
* like to use the ASCII version in bases that would be more
* frequented by users that can't support IBM-ANSI graphics,
* and use the IBM-ANSI in areas where users CAN support them).
* Additionally, using method 1 allows you NOT to use Guidelines
* in certain OTHER areas as well.
*
* Method 2 offers it's own advantages. The most noticable being
* the fact that you only need to modify ONE file(your bbstext),
* instead of having to create numerous "sys.entry" files. The
* other major advantage is that the Guidelines will be shown to
* EVERY user, regardless of their Help Level setting, whereas
* in Method 1, the Guidelines are ONLY shown to those users of
* the "Novice" Help Level.
*/
/* Look for the following files, which should have been included in the
CNet Amiga ToolKit, v3.00 archive:
Guidelines3_ASC - Ascii version for CNet, v3.05c.
Guidelines3_ANS - Ansi version for CNet, v3.05c.
Guidelines3_BEV - IBM-ANSI (Beveled) version for CNet, v3.05c.
Guidelines4_ASC - Ascii version for CNet, v4.26b.
Guidelines4_ANS - Ansi version for CNet, v4.26b.
Guidelines4_BEV - IBM-ANSI (Beveled) version for CNet, v4.26b.
*/
/**[42]*********************************************************************
*
* Description: NewDoor starter framework for New ARexx Doors/Pfiles.
* (This is similar to the "empty.c" file "C" coders have)
*
* Author(s): Dotoran - Frontiers BBS +716 823-9892
*
***************************************************************************
*
* Usage: Included in the CNet Amiga ToolKit, v3.00 is a file titled
* "NewDoor". This file can be used by ARexx programmers as
* a starting framework for NEW projects. Below is a descriptive
* breakdown of the lines found IN that file, so you'll know
* exactly what each line is there for! Lines starting with [>
* are comments by me, and are NOT part of the NewDoor file!
*/
-- NewDoor STARTS Here --
/**************************************************************************\
$VER: , v. (--97) by SysOp of BBS!
\**************************************************************************/
[> The $VER line allows you to create a VERSION string for your program. You
[> should place the NAME of your file BEFORE the comma above. Put the version
[> number after the "v", and it's creation date in DD-MMM-YY format within
[> the paries (Using DD-MMM-YY format eliminates confusion between different
[> date formats, like DD-MM-YY (USA), MM-DD-YY (Europe), etc.) Replace SysOp
[> with the Handle or Real Name of the author, and replace BBS with the name
[> of the BBS this file was either created on/for, or where the file can be
[> located for download(in the event the author doesn't run a BBS).
options results;signal on SYNTAX;signal on ERROR;signal on IOERR
[> Standard initial ARexx stuff. Nothing major here. ;-)
a=sourceline(2);parse var a . ", "ver" ("vdate")" .;a=random(,,time("s"))
[> This line creates two variables, "ver" and "vdate". The "ver" variable
[> will contain the VERSION number of the program (like v1.00 or v3.42), and
[> "vdate" will contain the file's creation date (like 10-May-97). You can
[> then USE these variables throughout the program whenever you wish this
[> information displayed to the screen. (This line grabs it's info directly
[> from the $VERsion string, so make sure to follow the correct format, as
[> described above). This line also seeds the random number generator, so as
[> to insure a good randomity to any random numbers your file may be using.
[> If your file will NOT be using the RANDOM() function, you can DELETE the
[> code that states: ;a=random(,,time("s"))
tr=transmit;se=sendstring;gc=getchar;gu=getuser;gs=getscratch;mg=maygetchar
[> I've used these before, and will mention them again. This line creates a
[> series of command aliases, or abbreviations, you can choose to use within
[> your program INSTEAD of using the entire command itself. For instance, the
[> following line would be valid: se "Want to continue? [Yes]: ";gc
[> Again, once your program is complete, you can DELETE any abbreviations you
[> may not have used in your program. Other aliases I've used include these:
[> pu=putuser ; ps=putscratch ; qu=query ; pr=prompt
a="rexxsupport.library";if ~show("l",a) then if ~addlib(a,0,-30) then exit
[> This line insures the ARexx Support library is available for use. This
[> line is not necessary if your program does not use any of the Support
[> functions: ALLOCMEM(), CLOSEPORT(), FREEMEM(), GETARG(), GETPKT(),
[> OPENPORT(), REPLY(), SHOWDIR(), SHOWLIST(), STATEF(), or WAITPKT().
parse source . . fp .;df=left(fp,max(lastpos('/',fp),lastpos(':',fp)))
[> This line creates the "fp" and "df" variables, for use with the Smart Home
[> Path technique for locating the programs origination path. In "fp", you'll
[> be given the ENTIRE "FilePath" to the program in question, while "df" will
[> return ONLY the PATH of the program. For instance, if the "NewDoor" file
[> was stored in "DOORS:", fp="doors:newdoor", while df="doors:". These two
[> variables, especially the "df" one, come in REAL handy when you'd like the
[> program to be able to find an included config or data file that resides in
[> the SAME directory as the parent file. This line allows the SysOp using
[> your program to be able to STORE the file ANYWHERE on their systems, and
[> it will be able to find it's support files (provided the SysOp remembers
[> to keep ALL the files TOGETHER).
[> The open GAP in the program is where YOU would include YOUR ARexx coding.
exit
[> As a safety measure, the "exit" insures that whatever code comes BEFORE
[> it doesn't mistakenly run into the Carrier Check routine below.
CHECK:;if ARG() & ARG(1)~="###PANIC" then return ARG(1)
getcarrier;if result="TRUE" then if ARG() then return ARG(1);else return
logentry "Lost Carrier!!";bufferflush;exit
[> This is a "Loss of Carrier" check. Check the Rexx ToolKit for more info
[> on it's correct usage.
SYNTAX:;ERROR:;IOERR:;e1="n1 Error: "rc" ("errortext(rc)")"
e2=" Line: "left(sigl,4)"File:";c="`"fp", "ver"'";e2=e2" "c;tr e1;tr e2
logentry e1;logentry e2;e=strip(translate(sourceline(sigl),"\{",""))
do while e~="";e3="Source: "left(e,37);tr e3;logentry e3;e=substr(e,38);end
bufferflush
[> This is a modified version Error Check routine that has been customized
[> for use within the "NewDoor" file. It utilizes the "fp" variable defined
[> at the START of this file to include the NAME of the file. It also uses
[> the "ver" variable, also defined above, to include the VERSION NUMBER of
[> the program in the returned error message. Note that the "tr" command
[> alias has also been used in this routine. This alias was defined above
[> as well. The returned Error Message contains the same information as the
[> original routine, described earlier in this document, under the "Error
[> Checking Routine".
[> Please REMEMBER that the above routine is CUSTOMIZED for use INSIDE this
[> ARexx program. Do NOT copy and paste this routine into other ARexx files,
[> unless you'll also be using the new header info as well, else the routine
[> will NOT function correctly. In fact, it'd be rather ironic to have an
[> Error CHECKING routine that had an ERROR in it ITSELF! hehe ;-)
/**************************************************************************\
\*********************************************** Your BBS (AAA)/PPP-SSSS **/
[> To finish up, this comment line serves two purposes. It tells the reader
[> they've reached the end of the code, as well as giving the PHONE NUMBER
[> of the Support BBS they should contact in the event any Bugs are found!
-- NewDoor ENDS Here --
****************************************************************************
Contributing Authors:
Dotoran - Frontiers BBS +1 716/823-9892
PMK - (Peter no longer runs a bbs...)
Aunt Bea - Blue Moon BBS +1 716/871-9866
Thomas - Dreamline Amiga BBS +45 3582-7043
Bill Beogelein - Amiga SWHQ +1 810/473-2020